home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE15 / IDAPI / Bdecmpnt / infotab.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-04  |  7.5 KB  |  265 lines

  1. {Copyright John O'Connell 1996.  All rights reserved}
  2. unit Infotab;
  3.  
  4. interface
  5.  
  6. uses
  7.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  8.   Forms, Dialogs, DB, DBTables, DbiProcs, DbiTypes;
  9.  
  10. type
  11.   TInfoType = (itNothing, itFamily, itPhysFields, itLogFields, itIndex, itRefInt,
  12.                 itTables, itValChecks);
  13.   TCfgType = (ctUsers, ctDatabases, ctDrivers, ctTableTypes, ctFieldTypes,
  14.                 ctIndexTypes, ctLanguageDrivers);
  15.   TDriverType = (dtParadox, dtDbase, dtAscii, dtInterbase, dtOracle);
  16.  
  17.   TIdapiCfg = class(TDataset)
  18.   private
  19.     { Private declarations }
  20.     FCfgType: TCfgType;
  21.     FDriverType: TDriverType;
  22.     procedure SetCfgType(const Value: TCfgType);
  23.     procedure SetDriver(const Value: TDriverType);
  24.   protected
  25.     { Protected declarations }
  26.   public
  27.     { Public declarations }
  28.     constructor Create(AOwner: TComponent); override;
  29.     function CreateHandle: HDbiCur; override;
  30.   published
  31.     { Published declarations }
  32.     property ConfigInfo: TCfgType read FCfgType write SetCfgType default ctUsers;
  33.     property DriverType: TDriverType read FDriverType write SetDriver default dtParadox;
  34.   end;
  35.  
  36.   TDBUserList = class(TDBDataset)
  37.   private
  38.     { Private declarations }
  39.   protected
  40.     { Protected declarations }
  41.   public
  42.     { Public declarations }
  43.     function CreateHandle: HDbiCur; override;
  44.   published
  45.     { Published declarations }
  46.   end;
  47.  
  48.   TTableLocks = class(TDataset)
  49.   private
  50.     { Private declarations }
  51.     FAllUsers: Boolean;
  52.     FAllLockTypes: Boolean;
  53.     FDataLink: TFieldDataLink;
  54.     procedure SetDataSource(const Value: TDataSource);
  55.     function GetDataSource: TDataSource;
  56.     function CanOpenLockList: Boolean;
  57.     procedure DoActiveChanged(Sender: TObject);
  58.   protected
  59.     { Protected declarations }
  60.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  61.   public
  62.     { Public declarations }
  63.     constructor Create(AOwner: TComponent); override;
  64.     destructor Destroy; override;
  65.     function CreateHandle: HDbiCur; override;
  66.   published
  67.     { Published declarations }
  68.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  69.     property AllUsers: boolean read FAllUsers write FAllUsers default True;
  70.     property AllLockTypes: boolean read FAllLockTypes write FAllLockTypes default True;
  71.   end;
  72.  
  73.   TTableInfo = class(TTable)
  74.   private
  75.     { Private declarations }
  76.     FInfoType: TInfoType;
  77.     FDriverType: TDriverType;
  78.     procedure SetInfoType(const Value: TInfoType);
  79.     procedure SetDriver(const Value: TDriverType);
  80.   protected
  81.     { Protected declarations }
  82.   public
  83.     { Public declarations }
  84.     constructor Create(AOwner: TComponent); override;
  85.     function CreateHandle: HDbiCur; override;
  86.   published
  87.     { Published declarations }
  88.     property TableInfo: TInfoType read FInfoType write SetInfoType default itNothing;
  89.     property DriverType: TDriverType read FDriverType write SetDriver default dtParadox;
  90.   end;
  91.  
  92. procedure Register;
  93.  
  94. implementation
  95.  
  96. const Driver: array[TDriverType] of PChar = (szPARADOX, szDBASE, szASCII,
  97.                 'INTRBASE','ORACLE');
  98.  
  99. { TIdapiCfg }
  100.  
  101. constructor TIdapiCfg.Create(AOwner: TComponent);
  102. begin
  103.   inherited Create(AOwner);
  104.   FCfgType := ctUsers;
  105.   FDriverType := dtParadox;
  106. end;
  107.  
  108. function TIdapiCfg.CreateHandle: HDbiCur;
  109. begin
  110.   Result := nil;
  111.   case FCfgType of
  112.     ctUsers:           Check(DbiOpenUserList(Result));
  113.     ctDatabases:       Check(DbiOpenDatabaseList(Result));
  114.     ctDrivers:         Check(DbiOpenDriverList(Result));
  115.     ctLanguageDrivers: Check(DbiOpenLdList(Result));
  116.     ctTableTypes:      Check(DbiOpenTableTypesList(Driver[FDriverType],Result));
  117.     ctFieldTypes:      Check(DbiOpenFieldTypesList(Driver[FDriverType],nil,Result));
  118.     ctIndexTypes:      Check(DbiOpenIndexTypesList(Driver[FDriverType],Result));
  119.   end;
  120. end;
  121.  
  122. procedure TIdapiCfg.SetDriver(const Value: TDriverType);
  123. begin
  124.   CheckInactive;
  125.   FDriverType := Value;
  126. end;
  127.  
  128. procedure TIdapiCfg.SetCfgType(const Value: TCfgType);
  129. begin
  130.   CheckInactive;
  131.   FCfgType := Value;
  132. end;
  133.  
  134. { TDBUserList }
  135.  
  136. function TDBUserList.CreateHandle: HDbiCur;
  137. begin
  138.   Result := nil;
  139.   Check(DbiOpenUserList(Result));
  140. end;
  141.  
  142. { TTableLocks }
  143.  
  144. constructor TTableLocks.Create(AOwner: TComponent);
  145. begin
  146.   inherited Create(AOwner);
  147.   FDataLink := TFieldDataLink.Create;
  148.   FDataLink.OnActiveChange := DoActiveChanged;
  149.   FDataLink.OnDataChange   := nil;
  150.   FAllUsers     := True;
  151.   FAllLockTypes := True;
  152. end;
  153.  
  154. destructor TTableLocks.Destroy;
  155. begin
  156.   FDataLink.OnActiveChange := nil;
  157.   FDataLink.Free;
  158.   inherited Destroy;
  159. end;
  160.  
  161. procedure TTableLocks.Notification(AComponent: TComponent; Operation: TOperation);
  162. begin
  163.   inherited Notification(AComponent, Operation);
  164.   if (Operation = opRemove) and (FDataLink <> nil) and
  165.     (AComponent = DataSource) then DataSource := nil;
  166. end;
  167.  
  168. function TTableLocks.CanOpenLockList: Boolean;
  169. begin
  170.   Result := (DataSource <> nil) and
  171.             (DataSource.DataSet <> nil) and
  172.             (DataSource.DataSet.Active);
  173. end;
  174.  
  175. function TTableLocks.CreateHandle: HDbiCur;
  176. begin
  177.   Result := nil;
  178.   if CanOpenLockList then
  179.     with FDataLink.DataSet do
  180.       Check(DbiOpenLockList(Handle, FAllUsers, FAllLockTypes, Result));
  181. end;
  182.  
  183. procedure TTableLocks.SetDataSource(const Value: TDataSource);
  184. begin
  185.   if (Value = nil) then
  186.     FDataLink.DataSource := Value
  187.   else
  188.     if (Value.DataSet = nil) then
  189.       FDataLink.DataSource := Value
  190.     else
  191.       if (Value.DataSet.InheritsFrom(TTable)) then
  192.         FDataLink.DataSource := Value
  193.       else
  194.         raise EInvalidOperation.Create ('Dataset is not a TTable');
  195. end;
  196.  
  197. function TTableLocks.GetDataSource: TDataSource;
  198. begin
  199.   Result := FDataLink.DataSource;
  200. end;
  201.  
  202. procedure TTableLocks.DoActiveChanged(Sender: TObject);
  203. begin
  204.   if DataSource = nil then
  205.     Close
  206.   else
  207.     with DataSource do
  208.       if (DataSet = nil) then
  209.         Close
  210.       else if not DataSet.Active then
  211.         Close;
  212. end;
  213.  
  214. {TTableInfo}
  215.  
  216. constructor TTableInfo.Create(AOwner: TComponent);
  217. begin
  218.   inherited Create(AOwner);
  219.   FInfoType := itNothing;
  220.   FDriverType := dtParadox;
  221. end;
  222.  
  223. function TTableInfo.CreateHandle: HDbiCur;
  224. var TabName: array[0..DBIMAXNAMELEN] of char;
  225.     hDB: HDBIDb;
  226. begin
  227.   Result := nil;
  228.   hDB    := Database.Handle;
  229.   StrPCopy(TabName, TableName);
  230.  
  231.   if (FInfoType = itNothing) then
  232.     Result := inherited CreateHandle
  233.   else
  234.     case FInfoType of
  235.       itFamily    : Check(DbiOpenFamilyList(hDb, TabName, Driver[FDriverType], Result));
  236.       itPhysFields: Check(DbiOpenFieldList(hDb, TabName, Driver[FDriverType],
  237.                       True, Result));
  238.       itLogFields : Check(DbiOpenFieldList(hDb, TabName, Driver[FDriverType],
  239.                       False, Result));
  240.       itIndex     : Check(DbiOpenIndexList(hDb, TabName, Driver[FDriverType], Result));
  241.       itRefInt    : Check(DbiOpenRintList(hDb, TabName, Driver[FDriverType], Result));
  242.       itTables    : Check(DbiOpenTableList(hDb, True, True, nil, Result));
  243.       itValChecks : Check(DbiOpenVchkList(hDb, TabName, Driver[FDriverType], Result));
  244.     end;
  245. end;
  246.  
  247. procedure TTableInfo.SetDriver(const Value: TDriverType);
  248. begin
  249.   CheckInactive;
  250.   FDriverType := Value;
  251. end;
  252.  
  253. procedure TTableInfo.SetInfoType(const Value: TInfoType);
  254. begin
  255.   CheckInactive;
  256.   FInfoType := Value;
  257. end;
  258.  
  259. procedure Register;
  260. begin
  261.   RegisterComponents('JOC', [TIdapiCfg, TDBUserList, TTableLocks, TTableInfo]);
  262. end;
  263.  
  264. end.
  265.